home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / ldb / rt-assem.s < prev    next >
Text File  |  1991-11-06  |  5KB  |  261 lines
  1.     .globl    .oVncs
  2.     .set    .oVncs,0
  3.  
  4. #define LANGUAGE_ASSEMBLY
  5. #include "lispregs.h"
  6. #include "lisp.h"
  7. #include "globals.h"
  8.  
  9.     .text
  10.     .data    1
  11.     .globl    _call_into_lisp
  12. _call_into_lisp:
  13.     .long    _.call_into_lisp
  14.     .text
  15.     .align    1
  16.     .globl    _.call_into_lisp
  17. _.call_into_lisp:
  18. /* Save the callee-saves registers. */
  19.     stm       r6,-64(r1)
  20. /* Put the pointer to our data area where we can use it. */
  21.     mr        r14,r0
  22. /* Move the callers stack pointer into our frame pointer. */
  23.     mr        r13,r1
  24. /* And allocate our frame on the stack. */
  25.     cal       r1,-64(r1)
  26.  
  27. /* Set up the lisp state. */
  28.     mr    CNAME, r2
  29.     mr    LEXENV, r3
  30.     mr    CFP, r4
  31.     mr    NARGS, r5
  32.     sli    NARGS, 2
  33.     get    NULLREG, $NIL
  34.  
  35. /* No longer in foreign function call. */
  36. /* Note: the atomic flag should still be set. */
  37.     lis    A0, 0
  38.     store    A0, _foreign_function_call_active, NL0
  39.  
  40. /* Load the rest of lisp state. */
  41.     load    CSP, _current_control_stack_pointer
  42.     load    OCFP, _current_control_frame_pointer
  43.  
  44. /* No longer atomic. */
  45.     store    A0, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, NL0
  46.  
  47. /* Were we interrupted? */
  48.     load    NL0, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
  49.     ci    NL0, 0
  50.     je    1f
  51.  
  52.     ti    7, r0, trap_PendingInterrupt
  53. 1:
  54.  
  55. /* Load the args. */
  56.     l    A0, 0(CFP)
  57.     l    A1, 4(CFP)
  58.     l    A2, 8(CFP)
  59.  
  60. /* Calculate LRA. */
  61.     get    LRA, $lra+type_OtherPointer
  62.  
  63. /* Indirect closure */
  64.     l    CODE, CLOSURE_FUNCTION_OFFSET(LEXENV)
  65.  
  66.     cal    LIP, FUNCTION_HEADER_CODE_OFFSET(CODE)
  67.     br    LIP
  68.  
  69.     .align    3
  70. lra:
  71.     .long    type_ReturnPcHeader
  72.  
  73. /* Blow off any extra values. */
  74.     cal    CSP, 0(OCFP)    /* We must use a 32-bit instruction here */
  75.  
  76. /* Save the return value. */
  77.     mr    r2, A0
  78.  
  79. /* Turn on pseudo-atomic */
  80.     store    CFP, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, r3
  81.  
  82. /* Store lisp state */
  83.     store    CSP, _current_control_stack_pointer, r3
  84.     store    CFP, _current_control_frame_pointer, r3
  85.  
  86. /* No longer in lisp. */
  87.     store    CFP, _foreign_function_call_active, r3
  88.  
  89. /* Were we interrupted? */
  90.     load    r3, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
  91.     ci    r3, 0
  92.     je    1f
  93.  
  94. /* Yep. */
  95.     ti    7, r0, trap_PendingInterrupt
  96.  
  97. 1:
  98. /* Restore callee-saves registers. */
  99.     lm    r6,0(r1)
  100. /* Return to C */
  101.     brx    r15
  102. /* And reset the stack. */
  103.     ai    r1,64
  104.  
  105. /* Noise to keep debuggers happy. */
  106.     .long    0xDF07DF68
  107.     .short    0x0110
  108.  
  109.  
  110. /* Call_into_C
  111.  
  112. On entry:
  113.  NL0 - addr of fn to call
  114.  NSP[0]...NSP[n-1] - args
  115.  LRA, CODE - must be preserved (and GCed if necessary)
  116.  
  117. */
  118.  
  119.     .text
  120.     .globl    call_into_c
  121. call_into_c:
  122.     /* Build a stack frame. */
  123.     mr    OCFP, CFP
  124.     mr    CFP, CSP
  125.     cal    CSP, 32(CSP)
  126.     st    OCFP, 0(CFP)
  127.     st    LRA, 4(CFP)
  128.     st    CODE, 8(CFP)
  129.     
  130.     /* Get the text addr we are supposed to jump to */
  131.     l    r15, 0(NL0)
  132.     mr    r0, NL0
  133.  
  134.     /* Set pseudo-atomic. */
  135.     store    CFP, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, r3
  136.  
  137.     /* Save lisp state. */
  138.     store    CSP, _current_control_stack_pointer, r2
  139.     store    CFP, _current_control_frame_pointer, r2
  140.  
  141.     /* Now in foreign function call land */
  142.     store    CFP, _foreign_function_call_active, r2
  143.  
  144.     /* Were we interrupted? */
  145.     load    r3, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
  146.     ci    r3, 0
  147.     je    1f
  148.  
  149. /* Yep. */
  150.     ti    7, r0, trap_PendingInterrupt
  151.  
  152. 1:
  153.     /* Get the first 4 args, and adjust the stack pointer.  We need to */
  154.     /* adjust the stack pointer because r1 is supposed to point at the */
  155.     /* 5th argument, not the 1st.  This is easier than trying to fix */
  156.     /* pack to be able to deal with TNs with a negative offset. */
  157.     l    r2, 0(r1)
  158.     l    r3, 4(r1)
  159.     l    r4, 8(r1)
  160.     l    r5, 12(r1)
  161.     cal    r1, 16(r1)
  162.  
  163.     /* And hit it. */
  164.     balr    r15, r15
  165.  
  166.     /* Save the second return value (assuming there is one) */
  167.     mr    NARGS, OCFP
  168.  
  169.     /* Clear desriptor regs.  We have to do this before we clear the
  170.     foreign-function-call-active flag even if we are just going to
  171.     load the saved value back into the reg to make sure we don't keep
  172.     ahold of any pointers that have been moved by GC. */
  173.     lis    CODE, 0
  174.     lis    CNAME, 0
  175.     lis    LEXENV, 0
  176.     lis    LRA, 0
  177.     lis    A0, 0
  178.     lis    A1, 0
  179.     lis    A2, 0
  180.  
  181. /* No longer in foreign function call. */
  182. /* Note: the atomic flag should still be set. */
  183.     lis    A0, 0
  184.     store    A0, _foreign_function_call_active, OCFP
  185.  
  186. /* Load the rest of lisp state. */
  187.     load    CSP, _current_control_stack_pointer
  188.     load    CFP, _current_control_frame_pointer
  189.  
  190. /* No longer atomic. */
  191.     store    A0, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, OCFP
  192.  
  193. /* Were we interrupted? */
  194.     load    OCFP, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
  195.     ci    OCFP, 0
  196.     je    1f
  197.  
  198.     ti    7, r0, trap_PendingInterrupt
  199. 1:
  200.  
  201.     /* Restore OCFP, LRA & CODE (they may have been GC'ed) */
  202.     l    OCFP, 0(CFP)
  203.     l    LRA, 4(CFP)
  204.     l    CODE, 8(CFP)
  205.  
  206.     /* Reset the stack. */
  207.     mr    CSP, CFP
  208.     mr    CFP, OCFP
  209.     cal    r1, -16(r1)
  210.  
  211.     /* Restore the second return value */
  212.     mr    OCFP, NARGS
  213.  
  214.     /* And return */
  215.     cal    LIP, (4-type_OtherPointer)(LRA)
  216.     br    LIP
  217.  
  218.  
  219.  
  220.     .text
  221.     .globl    undefined_tramp
  222. undefined_tramp:
  223.     ti    7, r0, trap_Error
  224.     .byte    4
  225.     .byte    23
  226.     .byte    254
  227.     .byte    43
  228.     .byte    1
  229.     .align    2
  230.  
  231.     .globl    closure_tramp
  232. closure_tramp:
  233.         l    LEXENV, SYMBOL_FUNCTION_OFFSET(CNAME)
  234.         l    CNAME, CLOSURE_FUNCTION_OFFSET(LEXENV)
  235.         cal    LIP, FUNCTION_HEADER_CODE_OFFSET(CNAME)
  236.         br    LIP
  237.  
  238. /*
  239.  * Function-end breakpoint magic.
  240.  */
  241.     .text
  242.     .align    2
  243.     .globl    _function_end_breakpoint_guts
  244. _function_end_breakpoint_guts:
  245.     .long    type_ReturnPcHeader
  246.     b    1f
  247.     mr    OCFP, CSP
  248.     inc    CSP, 4
  249.     lis    NARGS, 4
  250.     mr    A1, NULLREG
  251.     mr    A2, NULLREG
  252. 1:
  253.  
  254.     .globl    _function_end_breakpoint_trap
  255. _function_end_breakpoint_trap:
  256.     ti    7, r0, trap_FunctionEndBreakpoint
  257.     b    1b
  258.  
  259.     .globl    _function_end_breakpoint_end
  260. _function_end_breakpoint_end:
  261.